home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
smaltalk
/
manchest.lha
/
MANCHESTER
/
manchester
/
2.2
/
actors
/
SMACKv1.0.st
< prev
next >
Wrap
Text File
|
1993-07-24
|
87KB
|
3,131 lines
" NAME SMACKv1.0
AUTHOR manchester
FUNCTION ?
ST-VERSION 2.2
PREREQUISITES
CONFLICTS
DISTRIBUTION world
VERSION 1
DATE 16 Aug 1988"
Model subclass: #ActorInterpreter
instanceVariableNames: 'activeActor activeList running auto stopWhenEmpty processing '
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Interpreter'!
ActorInterpreter comment:
'I represent an interpreter for actors. I maintain a list of active
actors, which I process when sent the `runProcess'' message
(usually from a controller). My instance variables:
activeActor <Actor> which is currently processing a message, or (nil).
activeList <ActorCollection> of active actors; i.e. actors which
have one or more Tasks on their mail queues.
running <Boolean> if true, execute the next active actor when send the
runProcess message. Otherwise, do nothing.
auto <Boolean> if true, will interpret actors from the activeList even
when my controller (if any) does not have control.
processing <Boolean> if true, I am currently running in `auto'' mode. Continue
to process further actors until the activeList is empty.
stopWhenEmpty <Boolean> if true, reset the running flag when the active
list becomes empty.
The `auto'' and `stopWhenEmpty'' flags are interpreted to give the "mode" of
the instance:
auto stopWhenEmpty mode
----------------------------
false false normal
false true manual
true false auto
true true *invalid*
'!
!ActorInterpreter methodsFor: 'initialize-release'!
initialize
"Initialize the instance variables."
activeList _ ActorCollection new.
running _ true.
stopWhenEmpty _ false.
auto _ true.
processing _ false!
release
"Release any views, or other dependents."
activeActor release.
activeList release.
self changed: #release.
super release! !
!ActorInterpreter methodsFor: 'accessing'!
activeList
"Answer with the list of active actors which I am processing."
^activeList!
auto
"Answer with the state of the auto flag."
^auto!
auto: bool
"Set the state of the auto flag to bool."
auto _ bool!
includes: anActor
"Answer true if the receiver already refers to anActor, otherwise false."
^activeList includes: anActor!
running
"Answer whether the receiver is runnable."
^running!
size
"Answer with the number of active actors on my list."
^activeList size!
stopWhenEmpty
"Answer with the state of the stopWhenEmpty flag."
^stopWhenEmpty!
stopWhenEmpty: bool
"Set the state of the stopWhenEmpty flag to bool."
stopWhenEmpty _ bool! !
!ActorInterpreter methodsFor: 'adding'!
addActor: anActor
"Add anActor as one to be executed by the receiver."
(anActor == activeActor) ifFalse: [
activeList addLast: anActor.
self changed: #activeActors.
(auto & running & processing not) ifTrue: [
processing _ true.
self processAllActors]]! !
!ActorInterpreter methodsFor: 'removing'!
removeActor: anActor
"Remove anActor from the list known about by the receiver."
activeList remove: anActor ifAbsent: [^self].
self changed: #activeActor! !
!ActorInterpreter methodsFor: 'processing'!
processActor
"Process a single task from the first actor on the receiver's list.
Insert the actor at the end of the active list if it has further
items on its mail queue."
| currentTask |
activeActor _ activeList removeFirst.
currentTask _ activeActor getMessage.
currentTask isNil ifFalse: [
currentTask target == activeActor mailAddress ifFalse: [
self error: 'actor has received task not addressed to it'].
activeActor behaviour block
value: activeActor
value: activeActor aquaintances
value: currentTask communication.
currentTask release].
activeActor moreMessages
ifTrue: [activeList addLast: activeActor]
ifFalse: [self changed: #activeActor].
activeActor _ nil!
processAllActors
"Process the entire active list."
[processing & running] whileTrue: [self processOneActor]!
processOneActor
"Process the first Task on the mail queue of the first actor in the
receiver's active list, if any. Insert the actor at the end of the
active list if it has further items on its mail queue."
activeList isEmpty
ifTrue: [
processing _ false.
stopWhenEmpty ifTrue: [
running _ false.
self changed: #stopped]]
ifFalse: [self processActor]!
runProcess
"If the receiver is running, process the next actor from the
process list."
running ifTrue: [self processOneActor]!
startProcessing
"Start the receiver processing further actors."
running _ true!
stopProcessing
"Stop the receiver from processing further actors."
running _ false! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
ActorInterpreter class
instanceVariableNames: ''!
!ActorInterpreter class methodsFor: 'instance creation'!
new
"Answer with a new initialized instance of the receiver."
^super new initialize! !
Dictionary variableSubclass: #ActorDictionary
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Simulation'!
ActorDictionary comment:
'I am a subclass of Dictionary which knows about active inspectors.'!
!ActorDictionary methodsFor: 'initialize-release'!
release
"Release any views on me."
self associationsDo: [:eachAssociation |
eachAssociation key release.
eachAssociation value release].
self changed: #release.
super release! !
!ActorDictionary methodsFor: 'accessing'!
at: key put: value
"Override the method in the superclass in order to signal changes."
| temp |
temp _ super at: key put: value.
self changed: #all.
^temp! !
!ActorDictionary methodsFor: 'dictionary removing'!
removeKey: key ifAbsent: aBlock
"Override the method in the superclass in order to signal changes."
| temp |
temp _ super removeKey: key ifAbsent: aBlock.
self changed: #all.
^temp! !
!ActorDictionary methodsFor: 'inspecting'!
inspect
"Use special dictionary inspector for actor simulations."
SMACKInspectorView open: (ActorDictionaryInspector inspect: self)!
labelString
"Answer with a string suitable for use as a view's label."
^self class name! !
OrderedCollection variableSubclass: #ActorCollection
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Simulation'!
ActorCollection comment:
'I am a subclass of OrderedCollection which knows about
interactive inspectors.'!
!ActorCollection methodsFor: 'initialize-release'!
release
"Release any views on me."
self do: [:each | each release].
self changed: #release.
super release! !
!ActorCollection methodsFor: 'accessing'!
at: anInteger put: anObject
"Override the method in the superclass in order to indicate changes."
| temp |
temp _ super at: anInteger put: anObject.
self changed: #all.
^temp! !
!ActorCollection methodsFor: 'adding'!
addLast: newObject
"Override the method in the sueprclass in order to signal changes."
| temp |
temp _ super addLast: newObject.
self changed: #all.
^temp! !
!ActorCollection methodsFor: 'removing'!
remove: oldObject ifAbsent: aBlock
"Override the method in the superclass in order to signal changes."
| temp |
temp _ super remove: oldObject ifAbsent: aBlock.
self changed: #all.
^temp!
removeFirst
"Override the method in the superclass in order to signal changes."
| temp |
temp _ super removeFirst.
self changed: #all.
^temp!
removeLast
"Override the method in the superclass in order to signal changes."
| temp |
temp _ super removeLast.
self changed: #all.
^temp! !
!ActorCollection methodsFor: 'inspecting'!
inspect
"Use special inspector for actor simulations."
SMACKInspectorView open: (ActorCollectionInspector inspect: self)!
labelString
"Answer with a string suitable for use as a view's label."
^self class name! !
!ActorCollection methodsFor: 'private'!
insert: anObject before: spot
"Override the method in the superclass in order to signal changes."
| temp |
temp _ super insert: anObject before: spot.
self changed: #all.
^temp! !
Model subclass: #ActorModel
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Simulation'!
ActorModel comment:
'I represent the abstract superclass of `dynamic'' actor entities; i.e. those
which are created and destroyed as the system runs.'!
!ActorModel methodsFor: 'initialize-release'!
release
"Remove any views on me. Subclasses should include 'super release'
in any re-implementations."
self changed: #release.
super release! !
!ActorModel methodsFor: 'inspecting'!
inspect
"Use special inspector for actor simulations."
SMACKInspectorView open: (SMACKInspector inspect: self)!
labelString
"Answer with a string suitable for use as a view's label."
^self printString! !
ActorModel subclass: #MailSystem
instanceVariableNames: 'table '
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Simulation'!
MailSystem comment:
'I represent a mail system capable of routing messages (Tasks) from one
actor to another.
My instance variables are:
table <ActorDictionary> with <key> being a <MailAddress>, and <value>
being a <Actor>.'!
!MailSystem methodsFor: 'initialize-release'!
initialize
"Initialize the address table."
table _ ActorDictionary new!
release
"Release my instance variables."
table release.
super release! !
!MailSystem methodsFor: 'accessing'!
table
"Answer with the table of addresses. Only used by the inspector."
^table! !
!MailSystem methodsFor: 'adding'!
addAddress: mailAddress to: actor
"Insert the mail address mailAddress to the Actor actor in the
routing table. Answer with the actor inserted."
table at: mailAddress put: actor.
self changed: #all.
^actor! !
!MailSystem methodsFor: 'removing'!
removeAddress: mailAddr
"Remove knowledge of the mail address mailAddr, and the associated
actor, from the routing table. Answer with the actor associated with
mailAddr. Create a error message if the mailAddr is unknown."
| temp |
temp _ table
removeKey: mailAddr
ifAbsent: ["self error:
'Trying to remove a non-existent mail address'." ^nil].
self changed: #all.
^temp value! !
!MailSystem methodsFor: 'sending'!
send: aTask to: aMailAddress
"Send aTask to the actor with address
aMailAddress."
(table at: aMailAddress
ifAbsent: [^self error: 'Trying to send to non-existent mail address'])
addMessage: aTask! !
!MailSystem methodsFor: 'printing'!
printOn: aStream
"Put a printable representation of the receiver on aStream."
aStream nextPutAll: self class name.
aStream nextPutAll: ' ('.
table size printOn: aStream.
aStream nextPut: $)! !
!MailSystem methodsFor: 'garbage collection'!
garbageCollect
"Remove unwanted actors from the mail system."
"MailAddress mailer garbageCollect."
| g1 g2 actor size |
g1 _ Smalltalk select: [:g | g class == MailAddress].
g2 _ ActorDictionary new.
g1 associationsDo: [:eachAssociation |
g2
at: (Smalltalk at: eachAssociation key)
put: (self removeAddress: eachAssociation value)].
size _ table size.
table release.
self initialize.
Smalltalk garbageCollect.
Transcript show: 'Collected ', size printString, ' actors'; cr.
g2 associationsDo: [:e | self addAddress: e key to: e value]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
MailSystem class
instanceVariableNames: ''!
!MailSystem class methodsFor: 'instance creation'!
new
"Create a new initialized instance of the receiver."
^super new initialize! !
ActorModel subclass: #MailAddress
instanceVariableNames: ''
classVariableNames: 'Mailer '
poolDictionaries: ''
category: 'Actors-Simulation'!
MailAddress comment:
'I represent a unique mail address to which messages may be
sent. Messages are routed by an instance of <MailSystem>,
referred to by my class variable `Mailer''. Mail addresses do not
change.'!
!MailAddress methodsFor: 'initialize-release'!
release
"Remove my actor from the mail system."
self removeAddress.
super release! !
!MailAddress methodsFor: 'adding'!
addAddressTo: actor
"Add the receiver as a mail address to the Actor actor, in the mail system."
Mailer addAddress: self to: actor! !
!MailAddress methodsFor: 'removing'!
removeAddress
"Remove the receiver as a mail address known about by the
mail system."
Mailer removeAddress: self! !
!MailAddress methodsFor: 'sending'!
send: aTask
"Send aTask to the actor with mail address represented by
the receiver."
Mailer send: aTask to: self!
sendCommunication: aCommunication
"Create a task with aCommunication, and send it to the actor
represented by the receiver."
(Task communication: aCommunication target: self) send!
sendMessage: aSymbol
"Create a task with a communication with name aSymbol and no
arguments, and send it to the actor represented by the receiver."
self sendCommunication: (Communication name: aSymbol)!
sendMessage: aSymbol with: firstArgument
"Create a task with a communication with name aSymbol and one
argument, and send it to the actor represented by the receiver."
self sendCommunication: (Communication name: aSymbol with: firstArgument)!
sendMessage: aSymbol with: firstArgument with: secondArgument
"Create a task with a communication with name aSymbol and two
arguments, and send it to the actor represented by the receiver."
self sendCommunication: (
Communication
name: aSymbol
with: firstArgument
with: secondArgument)!
sendMessage: aSymbol with: firstArgument with: secondArgument with: thirdArgument
"Create a task with a communication with name aSymbol and three
arguments, and send it to the actor represented by the receiver."
self sendCommunication: (
Communication
name: aSymbol
with: firstArgument
with: secondArgument
with: thirdArgument)!
sendMessage: aSymbol withArguments: anArray
"Create a task with a communication with name aSymbol and
arguments from anArray, and send it to the actor represented
by the receiver."
self sendCommunication: (Communication name: aSymbol withArguments: anArray)! !
!MailAddress methodsFor: 'printing'!
labelString
"Answer with a string suitable for use as a label."
^self class name, ' (', self printString, ')'!
printOn: aStream
"Put a printable representation of the receiver on aStream."
aStream nextPutAll: self asOop printString! !
!MailAddress methodsFor: 'inspecting'!
inspect
"Use special inspector for mail addresses."
SMACKInspectorView open: (MailAddressInspector inspect: self)! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
MailAddress class
instanceVariableNames: ''!
!MailAddress class methodsFor: 'class initialization'!
initialize
"Initialize my class variable, which represents a mail system
capable of routing messages between actors."
"MailAddress initialize."
Mailer notNil ifTrue: [Mailer release].
Mailer _ MailSystem new! !
!MailAddress class methodsFor: 'class access'!
mailer
"Answer with the current instance of MailSystem being used by
the receiver."
^Mailer! !
MailAddress initialize!
ActorModel subclass: #Aquaintances
instanceVariableNames: 'contents '
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Simulation'!
Aquaintances comment:
'I represent a list of aquaintances. My instance variable is:
contents <Dictionary> with <key> being a <Symbol> (my name for
the aquaintance), and <value> being a <MailAddress> for
the aquaintance.
'!
!Aquaintances methodsFor: 'initialize-release'!
initialize
"Initialize the instance variable."
contents _ ActorDictionary new.!
release
"Release all my instance variables."
contents release.
super release! !
!Aquaintances methodsFor: 'accessing'!
contents
"Answer with the entire aquaintance dictionary."
^contents!
name: aSymbol
"Answer with the mail address of an actor known by the receiver
as aSymbol. Create an error message if aSymbol is not found."
^contents
at: aSymbol
ifAbsent: [self error: 'Attempted to access an aquaintance which is unknown']!
name: aSymbol mailAddress: aMailAddress
"Insert the aquaintance known as aSymbol with address aMailAddress."
contents at: aSymbol put: aMailAddress.
self changed: #all! !
!Aquaintances methodsFor: 'sending'!
name: aName sendCommunication: aCommunication
"Send a Task containing aCommunication to the mailAddress
accessed by aName."
(self name: aName) sendCommunication: aCommunication!
name: aName sendMessage: aSymbol
"Send a message called aSymbol to the mailAddress
accessed by aName."
(self name: aName) sendMessage: aSymbol!
name: aName sendMessage: aSymbol with: firstArgument
"Send a message called aSymbol with one argument to the mailAddress
accessed by aName."
(self name: aName) sendMessage: aSymbol with: firstArgument!
name: aName sendMessage: aSymbol with: firstArgument with: secondArgument
"Send a message called aSymbol with two arguments to the mailAddress
accessed by aName."
(self name: aName)
sendMessage: aSymbol
with: firstArgument
with: secondArgument!
name: aName sendMessage: aSymbol with: firstArgument with: secondArgument with: thirdArgument
"Send a message called aSymbol with three arguments to the mailAddress
accessed by aName."
(self name: aName)
sendMessage: aSymbol
with: firstArgument
with: secondArgument
with: thirdArgument!
name: aName sendMessage: aSymbol withArguments: anArray
"Send a message called aSymbol with arguments from anArray
to the mailAddress accessed by aName."
(self name: aName) sendMessage: aSymbol withArguments: anArray! !
!Aquaintances methodsFor: 'printing'!
printOn: aStream
"Put a printable representation of the receiver on aStream."
self class name printOn: aStream.
aStream nextPutAll: ' (', contents size printString, ')'! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Aquaintances class
instanceVariableNames: ''!
!Aquaintances class methodsFor: 'instance creation'!
name: aSymbol mailAddress: aMailAddress
"Answer with an instance of the receiver which knows about
aSymbol referring to aMailAddress."
^self new name: aSymbol mailAddress: aMailAddress!
name: s1 mailAddress: m1 name: s2 mailAddress: m2
"Answer with an instance of the receiver which knows about
s1 referring to m1, and s2 referring to m3."
^(self new name: s1 mailAddress: m1) name: s2 mailAddress: m2!
new
"Answer with a new initialized instance of the receiver."
^super new initialize! !
ActorModel subclass: #Actor
instanceVariableNames: 'mailAddress behaviour mailQueue aquaintances '
classVariableNames: 'Interpreter '
poolDictionaries: ''
category: 'Actors-Simulation'!
Actor comment:
'I represent a potentially concurrent object.
My instance variables are:
behaviour <Behaviour> describing my actions when a message is
received.
mailAddress <MailAddress> representing the unique identity of an
instance of me.
mailQueue <MailQueue> representing messages to be processed.
aquaintances <Aquaintances> representing my names for other actors
instances of me know about.
My class variable "Interpreter" is an instance of <ActorInterpreter> which
represents the execution engine for instances of this class.'!
!Actor methodsFor: 'initialize-release'!
initialize
"Initialize the mail address, mail queue and aquaintances instance
variables."
mailAddress _ MailAddress new.
mailAddress addAddressTo: self.
mailQueue _ MailQueue new.
aquaintances _ Aquaintances new.!
release
"Nil out the receiver's mail address, to break up possible cycles.
Remove the receiver from the list maintained by the interpreter.
Release all the receiver's instance variables."
mailAddress _ nil.
mailQueue release.
behaviour release.
aquaintances release.
Interpreter removeActor: self.
super release! !
!Actor methodsFor: 'accessing'!
aquaintances
"Answer with the aquaintances of the receiver. Only used by the interpreter."
^aquaintances!
behaviour
"Answer with the behaviour of the receiver. Only used by the interpreter."
^behaviour!
mailAddress
"Answer with the mail address of the receiver."
^mailAddress! !
!Actor methodsFor: 'messages'!
addMessage: aMessage
"Add aMessage to the receiver's queue of messages."
| test |
test _ mailQueue isEmpty.
mailQueue addMessage: aMessage.
test ifTrue: [Interpreter addActor: self].
self changed: #all!
getMessage
"Answer with the first message from the mail queue. Only used by
the interpreter."
| task |
task _ mailQueue getMessage.
self changed: #all.
^task!
moreMessages
"Answer true if there are further messages to process, otherwise
false."
^mailQueue isEmpty not! !
!Actor methodsFor: 'behaviour'!
becomes: aBehaviour
"The behaviour of the receiver becomes aBehaviour. The
aquaintances are unchanged."
behaviour _ aBehaviour.
self changed: #all!
becomes: aBehaviour withAquaintances: anAquaintances
"The behaviour of the receiver becomes aBehaviour, with
aquaintances anAquaintances."
behaviour _ aBehaviour.
aquaintances _ anAquaintances.
self changed: #all! !
!Actor methodsFor: 'printing'!
printOn: aStream
"Put a printable representation of the receiver on aStream."
aStream nextPutAll: self class name.
aStream nextPutAll: ' ('.
mailAddress printOn: aStream.
aStream nextPut: $)! !
!Actor methodsFor: 'private'!
setAquaintances: anAquaintances
"Set the aquaintances of the receiver to anAquaintances."
aquaintances _ anAquaintances! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Actor class
instanceVariableNames: ''!
!Actor class methodsFor: 'instance creation'!
new
"Answer with a new initialized instance of the receiver."
^super new initialize!
withAquaintances: anAquaintances
"Create a new instance of the receiver, with aquaintances
defined by anAquaintances. Answer with the mail address of
the new instance."
^(self new setAquaintances: anAquaintances) mailAddress!
withAquaintances: anAquaintances withBehaviour: aBehaviour
"Create a new instance of the receiver, with aquaintances
defined by anAquaintances, and behaviour defined by aBehaviour.
Answer with the mail address of the new instance."
| temp |
temp _ self new setAquaintances: anAquaintances.
temp becomes: aBehaviour.
^temp mailAddress!
withBehaviour: aBehaviour
"Create a new instance of the receiver, with behaviour
defined by aBehaviour. Answer with the mail address of the new
instance."
^(self new becomes: aBehaviour) mailAddress!
withBehaviour: aBehaviour withAquaintances: anAquaintances
"Create a new instance of the receiver, with aquaintances
defined by anAquaintances, and behaviour defined by aBehaviour.
Answer with the mail address of the new instance."
| temp |
temp _ self new setAquaintances: anAquaintances.
temp becomes: aBehaviour.
^temp mailAddress! !
!Actor class methodsFor: 'class initialization'!
initialize
"Initialize the class variable Interpreter, which represents the
execution enginer for instances of the receiver."
"Actor initialize."
Interpreter notNil ifTrue: [Interpreter release].
Interpreter _ ActorInterpreter new.! !
!Actor class methodsFor: 'class access'!
interpreter
"Answer with the current instance of ActorInterpreter in use by
the receiver."
"Actor interpreter."
^Interpreter! !
!Actor class methodsFor: 'examples'!
exampleWorkspace1
"Select and execute the expressions here to play with actors."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
ActorTranscript sendMessage: #clear.
ActorTranscript sendMessage: #show with: 'Hello, world!!'.!
exampleWorkspace10
"Select and execute the expressions here to run a timed fibonacci example."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"This bit creates a global actor capable of timing."
"
Smalltalk at: #ActorTimer put:
(Actor withBehaviour:
(Behaviour block: [:slf :acq :com |
(com name == #now) ifTrue: [
(com at: 1)
sendMessage: #reply
withArguments: (Time dateAndTimeNow)].
(com name == #milliseconds) ifTrue: [
(com at: 1)
sendMessage: #reply
with: (Time millisecondClockValue)]])).
"
"This bit finds the time taken for 'null' activity."
"
| firstBehaviour secondBehaviour thirdBehaviour fourthBehaviour |
firstBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #start) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: secondBehaviour]].
secondBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
slf mailAddress sendMessage: #reply with: 1.
slf
becomes: thirdBehaviour
withAquaintances: (Aquaintances
name: #startTime mailAddress: (com at: 1))]].
thirdBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: fourthBehaviour]].
fourthBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTranscript sendMessage: #cr.
ActorTranscript
sendMessage: #show
with: 'Time taken for no activity was: '.
ActorTranscript sendMessage: #show with:
((com at: 1) - (acq name: #startTime)) printString.
ActorTranscript sendMessage: #show with: ' milliseconds.']].
(Actor withBehaviour: firstBehaviour) sendMessage: #start
"
"This bit actually runs the fibonacci example."
"
| firstBehaviour secondBehaviour thirdBehaviour fourthBehaviour
fibonacciBehaviour waitBothBehaviour waitOneBehaviour |
firstBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #start) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: secondBehaviour]].
secondBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
(Actor
withBehaviour: fibonacciBehaviour
withAquaintances: (Aquaintances
name: #replyTo
mailAddress: slf mailAddress))
sendMessage: #fibonacci with: 13.
slf
becomes: thirdBehaviour
withAquaintances: (Aquaintances
name: #startTime mailAddress: (com at: 1))]].
thirdBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: fourthBehaviour]].
fourthBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTranscript sendMessage: #cr.
ActorTranscript
sendMessage: #show
with: 'Time taken for fibonacci (13) was: '.
ActorTranscript sendMessage: #show with:
((com at: 1) - (acq name: #startTime)) printString.
ActorTranscript sendMessage: #show with: ' milliseconds.']].
fibonacciBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #fibonacci) ifTrue: [
((com at: 1) <= 1)
ifTrue: [
(acq name: #replyTo) sendMessage: #reply with: (com at: 1)]
ifFalse: [
slf becomes: waitBothBehaviour.
(Actor
withBehaviour: fibonacciBehaviour
withAquaintances: (Aquaintances
name: #replyTo
mailAddress: slf mailAddress))
sendMessage: #fibonacci
with: ((com at: 1) - 1).
(Actor
withBehaviour: fibonacciBehaviour
withAquaintances: (Aquaintances
name: #replyTo
mailAddress: slf mailAddress))
sendMessage: #fibonacci
with: ((com at: 1) - 2)]]].
waitBothBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
slf
becomes: waitOneBehaviour
withAquaintances: (Aquaintances
name: #replyTo mailAddress: (acq name: #replyTo)
name: #first mailAddress: (com at: 1))]].
waitOneBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
(acq name: #replyTo)
sendMessage: #reply
with: ((acq name: #first) + (com at: 1))]].
(Actor withBehaviour: firstBehaviour) sendMessage: #start
"!
exampleWorkspace11
"Select and execute the expressions here to run an iterative factorial example."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"
| startBehaviour iterateBehaviour |
startBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #factorial) ifTrue: [
slf
becomes: iterateBehaviour
withAquaintances: (Aquaintances
name: #current mailAddress: 1
name: #replyTo mailAddress: (acq name: #replyTo)).
slf mailAddress sendMessage: #iterate with: (com at: 1)]].
iterateBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #iterate)
ifTrue: [
((com at: 1) <= 1)
ifTrue: [
slf becomes: startBehaviour .
(acq name: #replyTo)
sendMessage: #reply with: (acq name: #current)]
ifFalse: [
acq name: #current mailAddress: (acq name: #current) * (com at: 1).
slf mailAddress sendMessage: #iterate with: ((com at: 1) - 1)]]].
(Actor
withBehaviour: startBehaviour
withAquaintances: (Aquaintances
name: #replyTo mailAddress: (Actor
withBehaviour: (Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTranscript sendMessage: #clear.
ActorTranscript
sendMessage: #show
with: (com at: 1) printString]])))) sendMessage: #factorial with: 20.
"!
exampleWorkspace12
"Select and execute the expressions here to run a timed iterative
factorial example."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"This bit creates a global actor capable of timing."
"
Smalltalk at: #ActorTimer put:
(Actor withBehaviour:
(Behaviour block: [:slf :acq :com |
(com name == #now) ifTrue: [
(com at: 1)
sendMessage: #reply
withArguments: (Time dateAndTimeNow)].
(com name == #milliseconds) ifTrue: [
(com at: 1)
sendMessage: #reply
with: (Time millisecondClockValue)]])).
"
"This bit finds the time taken for 'null' activity."
"
| firstBehaviour secondBehaviour thirdBehaviour fourthBehaviour |
firstBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #start) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: secondBehaviour]].
secondBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
slf mailAddress sendMessage: #reply with: 1.
slf
becomes: thirdBehaviour
withAquaintances: (Aquaintances
name: #startTime mailAddress: (com at: 1))]].
thirdBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: fourthBehaviour]].
fourthBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTranscript sendMessage: #cr.
ActorTranscript
sendMessage: #show
with: 'Time taken for no activity was: '.
ActorTranscript sendMessage: #show with:
((com at: 1) - (acq name: #startTime)) printString.
ActorTranscript sendMessage: #show with: ' milliseconds.']].
(Actor withBehaviour: firstBehaviour) sendMessage: #start
"
"This bit actually runs the iterative factorial example."
"
| firstBehaviour secondBehaviour thirdBehaviour fourthBehaviour
startBehaviour iterateBehaviour |
startBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #factorial) ifTrue: [
slf
becomes: iterateBehaviour
withAquaintances: (Aquaintances
name: #current mailAddress: 1
name: #replyTo mailAddress: (acq name: #replyTo)).
slf mailAddress sendMessage: #iterate with: (com at: 1)]].
iterateBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #iterate)
ifTrue: [
((com at: 1) <= 1)
ifTrue: [
slf becomes: startBehaviour .
(acq name: #replyTo)
sendMessage: #reply with: (acq name: #current)]
ifFalse: [
slf
becomes: iterateBehaviour
withAquaintances: (Aquaintances
name: #current
mailAddress: ((acq name: #current) * (com at: 1))
name: #replyTo
mailAddress: (acq name: #replyTo)).
slf mailAddress sendMessage: #iterate with: ((com at: 1) - 1)]]].
firstBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #start) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: secondBehaviour]].
secondBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
(Actor
withBehaviour: startBehaviour
withAquaintances: (Aquaintances
name: #replyTo
mailAddress: slf mailAddress))
sendMessage: #factorial with: 20.
slf
becomes: thirdBehaviour
withAquaintances: (Aquaintances
name: #startTime mailAddress: (com at: 1))]].
thirdBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: fourthBehaviour]].
fourthBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTranscript sendMessage: #cr.
ActorTranscript
sendMessage: #show
with: 'Time taken for factorial (20) was: '.
ActorTranscript sendMessage: #show with:
((com at: 1) - (acq name: #startTime)) printString.
ActorTranscript sendMessage: #show with: ' milliseconds.']].
(Actor withBehaviour: firstBehaviour) sendMessage: #start
"!
exampleWorkspace13
"Select and execute the expressions here to run a divide-and-conquor
factorial example."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"
| rangeBehaviour mid waitBothBehaviour waitOneBehaviour sink |
rangeBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #factorial) ifTrue: [
((com at: 1) = (com at: 2)) ifTrue: [
(acq name: #replyTo) sendMessage: #reply with: (com at: 1)].
((com at: 1) > (com at: 2)) ifTrue: [
(acq name: #replyTo) sendMessage: #reply with: 1].
((com at: 1) < (com at: 2)) ifTrue: [
slf becomes: waitBothBehaviour.
mid _ ((com at: 1) + (com at: 2)) // 2.
(Actor
withBehaviour: rangeBehaviour
withAquaintances: (Aquaintances
name: #replyTo mailAddress: slf mailAddress))
sendMessage: #factorial with: (com at: 1) with: mid.
(Actor
withBehaviour: rangeBehaviour
withAquaintances: (Aquaintances
name: #replyTo mailAddress: slf mailAddress))
sendMessage: #factorial with: (mid + 1) with: (com at: 2)]]].
waitBothBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
slf
becomes: waitOneBehaviour
withAquaintances: (Aquaintances
name: #replyTo mailAddress: (acq name: #replyTo)
name: #first mailAddress: (com at: 1))]].
waitOneBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
(acq name: #replyTo)
sendMessage: #reply
with: ((acq name: #first) * (com at: 1))]].
sink _ Actor withBehaviour: (Behaviour block: [:slf :acq :com |
(com name == #reply)
ifTrue: [
ActorTranscript sendMessage: #cr.
ActorTranscript sendMessage: #show with: (com at: 1) printString]]).
(Actor
withBehaviour: rangeBehaviour
withAquaintances: (Aquaintances name: #replyTo mailAddress: sink))
sendMessage: #factorial with: 1 with: 20
"!
exampleWorkspace14
"Select and execute the expressions here to run a timed version of the
divide-and-conquor factorial example. This is based on the code on page 45
of 'Object Oriented Concurrent Programming'."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"This bit creates a global actor capable of timing."
"
Smalltalk at: #ActorTimer put:
(Actor withBehaviour:
(Behaviour block: [:slf :acq :com |
(com name == #now) ifTrue: [
(com at: 1)
sendMessage: #reply
withArguments: (Time dateAndTimeNow)].
(com name == #milliseconds) ifTrue: [
(com at: 1)
sendMessage: #reply
with: (Time millisecondClockValue)]])).
"
"This bit finds the time taken for 'null' activity."
"
| firstBehaviour secondBehaviour thirdBehaviour fourthBehaviour |
firstBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #start) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: secondBehaviour]].
secondBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
slf mailAddress sendMessage: #reply with: 1.
slf
becomes: thirdBehaviour
withAquaintances: (Aquaintances
name: #startTime mailAddress: (com at: 1))]].
thirdBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: fourthBehaviour]].
fourthBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTranscript sendMessage: #cr.
ActorTranscript
sendMessage: #show
with: 'Time taken for no activity was: '.
ActorTranscript sendMessage: #show with:
((com at: 1) - (acq name: #startTime)) printString.
ActorTranscript sendMessage: #show with: ' milliseconds.']].
(Actor withBehaviour: firstBehaviour) sendMessage: #start
"
"This bit actually runs the factorial."
"
| firstBehaviour secondBehaviour thirdBehaviour fourthBehaviour
rangeBehaviour mid waitBothBehaviour waitOneBehaviour sink |
rangeBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #factorial) ifTrue: [
((com at: 1) = (com at: 2)) ifTrue: [
(acq name: #replyTo) sendMessage: #reply with: (com at: 1)].
((com at: 1) > (com at: 2)) ifTrue: [
(acq name: #replyTo) sendMessage: #reply with: 1].
((com at: 1) < (com at: 2)) ifTrue: [
slf becomes: waitBothBehaviour.
mid _ ((com at: 1) + (com at: 2)) // 2.
(Actor
withBehaviour: rangeBehaviour
withAquaintances: (Aquaintances
name: #replyTo mailAddress: slf mailAddress))
sendMessage: #factorial with: (com at: 1) with: mid.
(Actor
withBehaviour: rangeBehaviour
withAquaintances: (Aquaintances
name: #replyTo mailAddress: slf mailAddress))
sendMessage: #factorial with: (mid + 1) with: (com at: 2)]]].
waitBothBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
slf
becomes: waitOneBehaviour
withAquaintances: (Aquaintances
name: #replyTo mailAddress: (acq name: #replyTo)
name: #first mailAddress: (com at: 1))]].
waitOneBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
(acq name: #replyTo)
sendMessage: #reply
with: ((acq name: #first) * (com at: 1))]].
firstBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #start) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: secondBehaviour]].
secondBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
(Actor
withBehaviour: rangeBehaviour
withAquaintances: (Aquaintances
name: #replyTo
mailAddress: slf mailAddress))
sendMessage: #factorial with: 1 with: 20.
slf
becomes: thirdBehaviour
withAquaintances: (Aquaintances
name: #startTime mailAddress: (com at: 1))]].
thirdBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: fourthBehaviour]].
fourthBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTranscript sendMessage: #cr.
ActorTranscript
sendMessage: #show
with: 'Time taken for factorial (20) was: '.
ActorTranscript sendMessage: #show with:
((com at: 1) - (acq name: #startTime)) printString.
ActorTranscript sendMessage: #show with: ' milliseconds.']].
(Actor withBehaviour: firstBehaviour) sendMessage: #start
"!
exampleWorkspace2
"Select and execute the expressions here to run the forwarder example."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"
| forwarder |
forwarder _ Actor
withBehaviour: (Behaviour
block: [:slf :acq :com |
(acq name: #link) sendCommunication: com])
withAquaintances: (Aquaintances
name: #link
mailAddress: ActorTranscript).
forwarder sendMessage: #clear.
forwarder sendMessage: #show with: 'Hello, once again!!'.
"!
exampleWorkspace3
"Select and execute the expressions here to run the stack example."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"
| forwarderBehaviour stackBehaviour stackItemBehaviour sink stack |
forwarderBehaviour _ Behaviour block: [:slf :acq :com |
acq name: #link sendCommunication: com].
stackBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #pop) & (acq name: #content) notNil ifTrue: [
slf
becomes: forwarderBehaviour
withAquaintances: (Aquaintances
name: #link
mailAddress: (acq name: #link)).
(com at: 1)
sendMessage: #contents
with: (acq name: #content)].
(com name == #push) ifTrue: [
slf
becomes: stackBehaviour
withAquaintances: (Aquaintances
name: #link mailAddress: (Actor
withBehaviour: stackBehaviour
withAquaintances: (Aquaintances
name: #link mailAddress: (acq name: #link)
name: #content mailAddress: (acq name: #content)))
name: #content mailAddress: (com at: 1))]].
stackItemBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #show)
ifTrue: [
ActorTranscript sendMessage: #cr.
ActorTranscript sendMessage: #show with: 'Stack item: '.
ActorTranscript sendMessage: #show with: (acq name: #count) printString]].
sink _ Actor withBehaviour: (Behaviour block: [:slf :acq :com |
(com name == #contents)
ifTrue: [
(com at: 1) sendMessage: #show]]).
stack _ Actor withBehaviour: stackBehaviour withAquaintances: (
Aquaintances
name: #content mailAddress: nil
name: #link mailAddress: nil).
ActorTranscript sendMessage: #clear.
stack
sendMessage: #push
with: (Actor
withBehaviour: stackItemBehaviour
withAquaintances: (Aquaintances name: #count mailAddress: 1)).
stack
sendMessage: #push
with: (Actor
withBehaviour: stackItemBehaviour
withAquaintances: (Aquaintances name: #count mailAddress: 2)).
stack sendMessage: #pop with: sink.
stack
sendMessage: #push
with: (Actor
withBehaviour: stackItemBehaviour
withAquaintances: (Aquaintances name: #count mailAddress: 3)).
stack sendMessage: #pop with: sink.
stack sendMessage: #pop with: sink.
"!
exampleWorkspace4
"Select and execute the expressions here to run the simple recursive
factorial example."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"
| recFactorial customer recCustomer factorialActor resultActor |
recFactorial _ Behaviour block: [:slf :acq :com |
(com name == #factorial) ifTrue: [
slf becomes: recFactorial.
(com at: 1) = 0
ifTrue: [
(com at: 2) sendMessage: #result with: 1]
ifFalse: [
customer _ Actor
withBehaviour: recCustomer
withAquaintances: (Aquaintances
name: #n mailAddress: (com at: 1)
name: #replyTo mailAddress: (com at: 2)).
slf mailAddress
sendMessage: #factorial
with: ((com at: 1) - 1)
with: customer]]].
recCustomer _ Behaviour block: [:slf :acq :com |
(com name == #result) ifTrue: [
(acq name: #replyTo)
sendMessage: #result
with: ((acq name: #n) * (com at: 1))]].
resultActor _ Actor withBehaviour: (Behaviour block: [:slf :acq :com |
(com name == #result) ifTrue: [
ActorTranscript sendMessage: #clear.
ActorTranscript
sendMessage: #show
with: (com at: 1) printString]]).
factorialActor _ Actor withBehaviour: recFactorial.
factorialActor sendMessage: #factorial with: 3 with: resultActor.
"!
exampleWorkspace5
"Select and execute the expressions here to run another simple recursive
factorial example."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"
| recFactorial recCustomer factorialActor resultActor |
recFactorial _ Behaviour block: [:slf :acq :com |
(com name == #factorial) ifTrue: [
slf becomes: recFactorial.
(com at: 1) = 0
ifTrue: [
(com at: 2) sendMessage: #reply with: 1]
ifFalse: [
slf mailAddress
sendMessage: #factorial
with: ((com at: 1) - 1)
with: (Actor
withBehaviour: recCustomer
withAquaintances: (Aquaintances
name: #n mailAddress: (com at: 1)
name: #replyTo mailAddress: (com at: 2)))]]].
recCustomer _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
(acq name: #replyTo)
sendMessage: #reply
with: ((acq name: #n) * (com at: 1))]].
resultActor _ Actor withBehaviour: (Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTranscript sendMessage: #clear.
ActorTranscript
sendMessage: #show
with: (com at: 1) printString]]).
factorialActor _ Actor withBehaviour: recFactorial.
factorialActor sendMessage: #factorial with: 20 with: resultActor
"!
exampleWorkspace6
"Select and execute the expressions here to run a timer example."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"This bit creates a global actor capable of timing."
"
Smalltalk at: #ActorTimer put:
(Actor withBehaviour:
(Behaviour block: [:slf :acq :com |
(com name == #now) ifTrue: [
(com at: 1)
sendMessage: #reply
withArguments: (Time dateAndTimeNow)].
(com name == #milliseconds) ifTrue: [
(com at: 1)
sendMessage: #reply
with: (Time millisecondClockValue)]])).
"
"This bit prints the date and time on the Actor Transcript."
"
| resultActor |
resultActor _ Actor withBehaviour: (Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTranscript sendMessage: #clear.
ActorTranscript
sendMessage: #show
with: (com at: 1) printString, ' ', (com at: 2) printString]]).
ActorTimer sendMessage: #now with: resultActor.
"!
exampleWorkspace7
"Select and execute the expressions here to run another timer example."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"This bit creates a global actor capable of timing."
"
Smalltalk at: #ActorTimer put:
(Actor withBehaviour:
(Behaviour block: [:slf :acq :com |
(com name == #now) ifTrue: [
(com at: 1)
sendMessage: #reply
withArguments: (Time dateAndTimeNow)].
(com name == #milliseconds) ifTrue: [
(com at: 1)
sendMessage: #reply
with: (Time millisecondClockValue)]])).
"
"This bit displays the millisecond clock on the Actor Transcript."
"
| resultActor |
resultActor _ Actor withBehaviour: (Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTranscript sendMessage: #cr.
ActorTranscript
sendMessage: #show
with: (com at: 1) printString]]).
ActorTimer sendMessage: #milliseconds with: resultActor.
"!
exampleWorkspace8
"Select and execute the expressions here to run a timed simple recursive
factorial example."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"This bit creates a global actor capable of timing."
"
Smalltalk at: #ActorTimer put:
(Actor withBehaviour:
(Behaviour block: [:slf :acq :com |
(com name == #now) ifTrue: [
(com at: 1)
sendMessage: #reply
withArguments: (Time dateAndTimeNow)].
(com name == #milliseconds) ifTrue: [
(com at: 1)
sendMessage: #reply
with: (Time millisecondClockValue)]])).
"
"This bit finds the time taken for 'null' activity."
"
| firstBehaviour secondBehaviour thirdBehaviour fourthBehaviour |
firstBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #start) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: secondBehaviour]].
secondBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
slf mailAddress sendMessage: #reply with: 1.
slf
becomes: thirdBehaviour
withAquaintances: (Aquaintances
name: #startTime mailAddress: (com at: 1))]].
thirdBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: fourthBehaviour]].
fourthBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTranscript sendMessage: #cr.
ActorTranscript
sendMessage: #show
with: 'Time taken for no activity was: '.
ActorTranscript sendMessage: #show with:
((com at: 1) - (acq name: #startTime)) printString.
ActorTranscript sendMessage: #show with: ' milliseconds.']].
(Actor withBehaviour: firstBehaviour) sendMessage: #start
"
"This bit actually times the factorial."
"
| firstBehaviour secondBehaviour thirdBehaviour fourthBehaviour
recFactorial recCustomer |
firstBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #start) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: secondBehaviour]].
secondBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
(Actor withBehaviour: recFactorial)
sendMessage: #factorial with: 20 with: slf mailAddress.
slf
becomes: thirdBehaviour
withAquaintances: (Aquaintances
name: #startTime mailAddress: (com at: 1))]].
thirdBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTimer sendMessage: #milliseconds with: slf mailAddress.
slf becomes: fourthBehaviour]].
fourthBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
ActorTranscript sendMessage: #cr.
ActorTranscript
sendMessage: #show
with: 'Time taken for factorial (20) was: '.
ActorTranscript sendMessage: #show with:
((com at: 1) - (acq name: #startTime)) printString.
ActorTranscript sendMessage: #show with: ' milliseconds.']].
recFactorial _ Behaviour block: [:slf :acq :com |
(com name == #factorial) ifTrue: [
slf becomes: recFactorial.
(com at: 1) = 0
ifTrue: [
(com at: 2) sendMessage: #reply with: 1]
ifFalse: [
slf mailAddress
sendMessage: #factorial
with: ((com at: 1) - 1)
with: (Actor
withBehaviour: recCustomer
withAquaintances: (Aquaintances
name: #n mailAddress: (com at: 1)
name: #replyTo mailAddress: (com at: 2)))]]].
recCustomer _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
(acq name: #replyTo)
sendMessage: #reply
with: ((acq name: #n) * (com at: 1))]].
(Actor withBehaviour: firstBehaviour) sendMessage: #start
"!
exampleWorkspace9
"Select and execute the expressions here to run a fibonacci example."
ActorInterpreterView open. "Open a view on the actor interpreter."
ActorTextCollector open. "Open a view on the actor transcript."
MailAddress mailer inspect. "Open an inspector on the mail system."
MailAddress mailer garbageCollect. "Collect unwanted actors."
"
| fibonacciBehaviour waitBothBehaviour waitOneBehaviour sink |
fibonacciBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #fibonacci) ifTrue: [
((com at: 1) <= 1)
ifTrue: [
(acq name: #replyTo) sendMessage: #reply with: (com at: 1)]
ifFalse: [
slf becomes: waitBothBehaviour.
(Actor
withBehaviour: fibonacciBehaviour
withAquaintances: (Aquaintances
name: #replyTo
mailAddress: slf mailAddress))
sendMessage: #fibonacci
with: ((com at: 1) - 1).
(Actor
withBehaviour: fibonacciBehaviour
withAquaintances: (Aquaintances
name: #replyTo
mailAddress: slf mailAddress))
sendMessage: #fibonacci
with: ((com at: 1) - 2)]]].
waitBothBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
slf
becomes: waitOneBehaviour
withAquaintances: (Aquaintances
name: #replyTo mailAddress: (acq name: #replyTo)
name: #first mailAddress: (com at: 1))]].
waitOneBehaviour _ Behaviour block: [:slf :acq :com |
(com name == #reply) ifTrue: [
(acq name: #replyTo)
sendMessage: #reply
with: ((acq name: #first) + (com at: 1))]].
sink _ Actor withBehaviour: (Behaviour block: [:slf :acq :com |
(com name == #reply)
ifTrue: [
ActorTranscript sendMessage: #cr.
ActorTranscript sendMessage: #show with: (com at: 1) printString]]).
(Actor
withBehaviour: fibonacciBehaviour
withAquaintances: (Aquaintances name: #replyTo mailAddress: sink))
sendMessage: #fibonacci with: 13.
"! !
Actor initialize!
ActorModel subclass: #Behaviour
instanceVariableNames: 'block '
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Simulation'!
Behaviour comment:
'I represent the current activity of an actor. My instance variable:
block <BlockContext> which is activated when the actor receives a
task. The block expects three arguments, representing `slf'' (the
actor receiving the task), `acq'' (the aquaintances of the actor,
and `com'' the communication in the present task.'!
!Behaviour methodsFor: 'initialize-release'!
release
"Release the instance variable."
block release.
super release! !
!Behaviour methodsFor: 'accessing'!
block
"Answer with the block describing the behaviour of the receiver."
^block!
block: aBlock
"Make the activity of the receiver aBlock."
block _ aBlock.
self changed: #all! !
!Behaviour methodsFor: 'printing'!
printOn: aStream
"Put a printable representation of the receiver on aStream."
self class name printOn: aStream! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Behaviour class
instanceVariableNames: ''!
!Behaviour class methodsFor: 'instance creation'!
block: aBlock
"Create a new instance of the receiver, with activity called aSymbol
as described by aBlock."
^self new block: aBlock! !
ActorModel subclass: #Tag
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Simulation'!
Tag comment:
'I represent a unique identifier used to identify a Task. Tags do not change.'!
!Tag methodsFor: 'accessing'!
value
"Answer with the unique identifier represented by the receiver."
^self asOop! !
!Tag methodsFor: 'printing'!
printOn: aStream
"Put a printable representation of the receiver on aStream."
aStream nextPutAll: self value printString! !
ActorModel subclass: #Communication
instanceVariableNames: 'name arguments '
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Simulation'!
Communication comment:
'I represent the content of a message (Task) sent from one Actor to
another. Communications do not change. My instance variables are:
name <Symbol> identifying the operation intended.
arguments <Array> of arguments to the operation.'!
!Communication methodsFor: 'initialize-release'!
release
"Release all my instance variables."
name release.
arguments release.
super release! !
!Communication methodsFor: 'accessing'!
at: index
"Answer with the argument at index in the argument list."
^arguments at: index!
name
"Answer with the name of the receiver."
^name! !
!Communication methodsFor: 'printing'!
printOn: aStream
"Put a printable representation of the receiver on aStream."
self class name printOn: aStream.
aStream nextPutAll: ' called '.
name printString printOn: aStream.! !
!Communication methodsFor: 'inspecting'!
labelString
"Answer with a string suitable for use as a view's label."
^name printString! !
!Communication methodsFor: 'private'!
setArguments: anArray
"Set the arguments of the receiver to anArray."
arguments _ anArray!
setName: aSymbol
"Set the name of the receiver to aSymbol."
name _ aSymbol! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Communication class
instanceVariableNames: ''!
!Communication class methodsFor: 'instance creation'!
name: aSymbol
"Create a new instance of the receiver, with name aSymbol and
no arguments."
^self name: aSymbol withArguments: #()!
name: aSymbol with: anArgument
"Create a new instance of the receiver, with name aSymbol and
one argument."
^self name: aSymbol withArguments: (Array with: anArgument)!
name: aSymbol with: firstArgument with: secondArgument
"Create a new instance of the receiver, with name aSymbol and
two arguments."
^self
name: aSymbol
withArguments: (Array with: firstArgument with: secondArgument)!
name: aSymbol with: firstArgument with: secondArgument with: thirdArgument
"Create a new instance of the receiver, with name aSymbol and
three arguments."
^self
name: aSymbol
withArguments: (Array
with: firstArgument
with: secondArgument
with: thirdArgument)!
name: aSymbol withArguments: anArray
"Create a new instance of the receiver, with name aSymbol and
arguments in anArray."
| temp |
temp _ self new setName: aSymbol.
temp setArguments: anArray.
^temp! !
ActorModel subclass: #MailQueue
instanceVariableNames: 'contents '
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Simulation'!
MailQueue comment:
'I represent a queue of messages (Tasks) sent to an actor waiting to
be processed. An instance of me is associated with every actor. If an
actor''s mail queue is empty, it is said to be inactive. My instance variables:
contents <ActorCollection> of Tasks, possibly empty.'!
!MailQueue methodsFor: 'initialize-release'!
initialize
"Initialize the instance variable."
contents _ ActorCollection new!
release
"Release all my instance variables."
contents release.
super release! !
!MailQueue methodsFor: 'adding'!
addMessage: aTask
"Add the message aTask to the end of queue represented by
the receiver."
contents addLast: aTask.
self changed: #all! !
!MailQueue methodsFor: 'removing'!
getMessage
"Answer with the first message (Task) in the receiver, or nil, if
there is no message available."
| message |
contents isEmpty ifFalse: [
message _ contents removeFirst.
self changed: #all].
^message! !
!MailQueue methodsFor: 'testing'!
isEmpty
"Answer whether the mail queue represented by the receiver is
empty or not."
^contents isEmpty! !
!MailQueue methodsFor: 'printing'!
printOn: aStream
"Put a printable representation of the receiver on aStream."
self class name printOn: aStream.
aStream nextPutAll: ' (', contents size printString, ')'! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
MailQueue class
instanceVariableNames: ''!
!MailQueue class methodsFor: 'instance creation'!
new
"Answer with a new initialized instance of the receiver."
^super new initialize! !
ActorModel subclass: #Task
instanceVariableNames: 'tag target communication '
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Simulation'!
Task comment:
'I represent a message sent from one actor to another.
My instance variables are:
tag <Tag> unique identifier for this message.
target <MailAddress> of the destination actor.
communication <Communication> contents of the message.'!
!Task methodsFor: 'initialize-release'!
initialize
"Initialize the tag instance variable."
tag _ Tag new!
release
"Release the receiver's tag and communication instance variables. Nil
out the receiver's target, to break up possible cycles."
tag release.
target _ nil.
communication release.
super release! !
!Task methodsFor: 'accessing'!
communication
"Answer with the communication of the receiver. Used only by the interpreter."
^communication!
target
"Answer with the target mail address of the receiver. Used only
by the interpreter."
^target! !
!Task methodsFor: 'sending'!
send
"Send the receiver to the target."
target send: self! !
!Task methodsFor: 'printing'!
printOn: aStream
"Put a printable representation of the receiver on aStream."
| addr |
addr _ target isNil ifTrue: ['nowhere'] ifFalse: [target printString].
self class name printOn: aStream.
aStream nextPutAll: ' ('.
tag printOn: aStream.
aStream nextPutAll: ') to ', addr! !
!Task methodsFor: 'private'!
setCommunication: aCommunication
"Set the communication of the receiver to aCommunication."
communication _ aCommunication!
setTarget: aMailAddress
"Set the target mail address of the receiver to aMailAddress."
target _ aMailAddress! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Task class
instanceVariableNames: ''!
!Task class methodsFor: 'instance creation'!
communication: aCommunication target: mailAddr
"Answer with a new instance of the receiver, with communication
given by aCommunication, and target mailAddr."
| temp |
temp _ self new setTarget: mailAddr.
temp setCommunication: aCommunication.
^temp!
new
"Answer with a new initialised instance of the receiver."
^super new initialize! !
MouseMenuController subclass: #ActorInterpreterController
instanceVariableNames: ''
classVariableNames: 'ActorYellowButtonMenu ActorYellowButtonMessages '
poolDictionaries: ''
category: 'Actors-Interpreter'!
ActorInterpreterController comment:
'I represent a controller for a actor interpreter. I support a yellow button
menu allowing the mode to be changed, and my model to be inspected in
various ways.'!
!ActorInterpreterController methodsFor: 'initialize-release'!
initialize
"Set up the yellow button menu."
super initialize.
self yellowButtonMenu: ActorYellowButtonMenu
yellowButtonMessages: ActorYellowButtonMessages! !
!ActorInterpreterController methodsFor: 'control defaults'!
controlActivity
"If the keyboard is pressed, then hand control to the corresponding
subview. Then, cause the model to execute one interpreter cycle,
then continue as defined in the superclass."
sensor keyboardPressed ifTrue: [self processKey].
model runProcess.
super controlActivity!
isControlActive
"Answer true if the keyboard is pressed, or if control is active
as defined in the superclass, and the blue button is not pressed.
Otherwise, answer false."
^sensor keyboardPressed |
super isControlActive & sensor blueButtonPressed not!
isControlWanted
"Answer true if the cursor is inside the inset display box
of the receiver's view, or if the keyboard is pressed,
and answer false, otherwise."
^sensor keyboardPressed | self viewHasCursor!
processKey
"The user typed a key on the keyboard. Give control to the subView that
is selected by this key."
| aView |
aView _ view subViewContainingCharacter: sensor keyboard.
aView notNil ifTrue: [aView controller sendMessage]! !
!ActorInterpreterController methodsFor: 'menu messages'!
auto
"Set auto mode. The model (interpreter) runs when the `run' button
is pressed, regardless of whether control is over the view. The interpreter stops
when the queue becomes empty."
self model stopWhenEmpty: false.
self model auto: true.
self model changed: #mode!
inspectFirst
"Inspect the first actor on the active list, if any."
model activeList isEmpty
ifTrue: [view flash]
ifFalse: [model activeList first inspect]!
inspectModel
"Open an Inspector on the model (so that individual actors
can be inspected)."
self model activeList inspect!
manual
"Set manual mode. The model (interpreter) runs when the `run' button
is pressed, and control is over the view. The interpreter stops when
the queue becomes empty."
self model stopWhenEmpty: true.
self model auto: false.
self model changed: #mode!
normal
"Set normal mode. The model (interpreter) runs when the `run' button
is pressed, and control is over the view. The interpreter remains runnable
when the queue becomes empty."
self model stopWhenEmpty: false.
self model auto: false.
self model changed: #mode! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
ActorInterpreterController class
instanceVariableNames: ''!
!ActorInterpreterController class methodsFor: 'class initialization'!
initialize
"Initialize the menu class variables."
"ActorInterpreterController initialize."
ActorYellowButtonMenu _ PopUpMenu
labels: 'auto\normal\manual\inspect\inspect first' withCRs
lines: #(3).
ActorYellowButtonMessages _ #(auto normal manual inspectModel inspectFirst).! !
ActorInterpreterController initialize!
View subclass: #ActorInterpreterView
instanceVariableNames: 'stopButton goButton '
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Interpreter'!
ActorInterpreterView comment:
'I represent a view on an interpreter for actors.'!
!ActorInterpreterView methodsFor: 'subView access'!
subViewContainingCharacter: aCharacter
"Answer the receiver's subView that corresponds to the key, aCharacter.
Answer nil if no subView is selected by aCharacter."
self subViews reverseDo:
[:aSubView |
(aSubView containsKey: aCharacter) ifTrue: [^aSubView]].
^nil! !
!ActorInterpreterView methodsFor: 'updating'!
update: aParameter
"If aParameter is #stopped, then toggle the halt button. If
aParameter is #run, then toggle the run button. If aParameter
is #release, then close the view."
aParameter == #stopped ifTrue: [stopButton turnOn].
aParameter == #run ifTrue: [goButton turnOn].
aParameter == #release ifTrue: [self topView controller closeAndUnschedule]! !
!ActorInterpreterView methodsFor: 'private'!
insertButtonViews
"Set up the button views for a new instance of the receiver."
| stepView stopView runView connector |
stepView _ SwitchView new model: (
Button newOff onAction: [self model processOneActor]).
stepView label: ('step' asDisplayText).
stepView controller: IndicatorOnSwitchController new.
stepView borderWidth: 2.
stepView key: $s.
self addSubView: stepView viewport: (20@100 extent: 40@28).
connector _ Object new. "Dummy object for connections."
stopButton _ (OneOnSwitch newOff onAction: [self model stopProcessing]).
stopButton connection: connector.
stopView _ SwitchView new model: stopButton.
stopView label: ('halt' asDisplayText).
stopView borderWidth: 2.
stopView key: $h.
self addSubView: stopView viewport: (80@100 extent: 40@28).
goButton _ (OneOnSwitch newOn onAction: [self model startProcessing]).
goButton connection: connector.
runView _ SwitchView new model: goButton.
runView label: ('run' asDisplayText).
runView borderWidth: 2.
runView key: $r.
self addSubView: runView viewport: (140@100 extent: 40@28).!
insertDisplayViews
"Set up the display views for a new instance of the receiver."
| actorView modeView |
modeView _ ActorInterpreterModeView new.
modeView controller: NoController new.
modeView model: self model.
modeView insideColor: Form white.
modeView borderWidth: 2.
self addSubView: modeView viewport: (20 @ 12 extent: 160 @ 32).
actorView _ ActorInterpreterDisplayView new.
actorView model: self model.
actorView insideColor: Form white.
actorView controller: NoController new.
actorView borderWidth: 2.
self addSubView: actorView viewport: (20 @ 50 extent: 160 @ 32)! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
ActorInterpreterView class
instanceVariableNames: ''!
!ActorInterpreterView class methodsFor: 'instance creation'!
open
"Create and schedule a view on the current Actor interpreter."
"ActorInterpreterView open."
self openOn: Actor interpreter!
openOn: anActorInterpreter
"Create and schedule a view on anActorInterpreter."
"ActorInterpreterView openOn: Actor interpreter."
| topView view |
topView _ StandardSystemView
model: nil
label: 'Actor Interpreter'
minimumSize: 200@150.
topView insideColor: nil.
view _ self new.
view controller: ActorInterpreterController new.
view model: anActorInterpreter.
view insideColor: Form gray.
view borderColor: Form black.
view borderWidth: 1.
topView
addSubView: view
window: (0@0 extent: 200@150)
viewport: topView window.
view insertButtonViews.
view insertDisplayViews.
topView controller open! !
View subclass: #ActorInterpreterDisplayView
instanceVariableNames: 'displayedValue '
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Interpreter'!
ActorInterpreterDisplayView comment:
'I represent a display of the number of active actors in the model.'!
!ActorInterpreterDisplayView methodsFor: 'displaying'!
displayView
"Display the number of actors on the model's list."
displayedValue _ model size.
((displayedValue = 1)
ifTrue: ['1 actor active']
ifFalse: [self model size printString, ' actors active'])
displayAt: (self insetDisplayBox topLeft + (10@6)).! !
!ActorInterpreterDisplayView methodsFor: 'updating'!
update: parameter
"If the parameter is #activeActors, update the displayed
value, provided that my topView is not collapsed."
(displayedValue isNil or: [displayedValue ~= model size]) ifTrue: [
self topView isCollapsed ifFalse: [
self displaySafe: [self display]]]! !
!ActorInterpreterDisplayView methodsFor: 'subView access'!
containsKey: aCharacter
"This view does not respond to any characters."
^false! !
View subclass: #ActorInterpreterModeView
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Interpreter'!
ActorInterpreterModeView comment:
'I represent a display of the mode of the model.'!
!ActorInterpreterModeView methodsFor: 'displaying'!
displayView
"Display the current mode."
| stop |
stop _ self model stopWhenEmpty.
(Text
string: (self model auto
ifTrue: [stop ifTrue: ['Unknown mode'] ifFalse: ['Auto mode']]
ifFalse: [stop ifTrue: ['Manual mode'] ifFalse: ['Normal mode']])
emphasis: 2) asDisplayText displayAt: (self insetDisplayBox topLeft + (10@6))! !
!ActorInterpreterModeView methodsFor: 'subView access'!
containsKey: aCharacter
"This view does not respond to any characters."
^false! !
!ActorInterpreterModeView methodsFor: 'updating'!
update: aParameter
"If parameter is #mode, update the receiver's display. Otherwise,
do nothing."
aParameter == #mode ifTrue: [ self display]!
!StandardSystemController subclass: #SMACKInspectorController
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Inspectors'!
SMACKInspectorController comment:
'I am a special kind of InspectorController which knows to how to remove
dependents before closing.'!
!SMACKInspectorController methodsFor: 'scheduling'!
close
"Remove the dependency between the model's object and the
model before closing."
model object removeDependent: model.
super close! !
InspectorView subclass: #SMACKInspectorView
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Inspectors'!
SMACKInspectorView comment:
'I represent a view on a special Inspector for Actor simulations. I
change my visible state when my model is updated, and can close
and unschedule myself when the object being inspected is no longer
required. I also support active icons.'!
!SMACKInspectorView methodsFor: 'updating'!
update: aParameter
"If aParameter is #all, redisplay the view. If aParameter is
#release, remove the view. Otherwise do nothing."
aParameter == #all ifTrue: [
^self displaySafe: [
self isCollapsed ifFalse: [
model changed: #field.
model changed: #text].
self newLabel: model object labelString]].
aParameter == #release ifTrue: [controller closeAndUnschedule]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SMACKInspectorView class
instanceVariableNames: ''!
!SMACKInspectorView class methodsFor: 'private'!
buildScheduledView: anInspector
| topView |
topView _ self
model: anInspector
label: anInspector object labelString
minimumSize: 180 @ 120.
topView controller: SMACKInspectorController new.
topView icon: (Icon constantNamed: #actor).
self
view: anInspector
in: (0 @ 0 extent: 1 @ 1)
of: topView.
^topView! !
Inspector subclass: #SMACKInspector
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Inspectors'!
SMACKInspector comment:
'I represent a special kind of Inspector for Actor components. I
change myself when the object inspected updates itself.'!
!SMACKInspector methodsFor: 'updating'!
update: aParameter
"Assume everything has changed. Update all dependents."
self changed: aParameter! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
SMACKInspector class
instanceVariableNames: ''!
!SMACKInspector class methodsFor: 'instance creation'!
inspect: anActor
"Answer an instance of me to provide an inspector
for anActor. Ensure that my instance is a dependent of
anActor."
| temp |
temp _ self new.
anActor addDependent: temp.
^temp inspect: anActor! !
SMACKInspector subclass: #ActorDictionaryInspector
instanceVariableNames: ''
classVariableNames: 'ActorDictListMenu '
poolDictionaries: ''
category: 'Actors-Inspectors'!
ActorDictionaryInspector comment:
'I am a special kind of SMACKInspector which knows how to inspect dictionaries.'!
!ActorDictionaryInspector methodsFor: 'field list'!
acceptText: aText from: aController
| val |
field == nil ifTrue: [^ false].
val _ self evaluateText: aText string from: aController ifFail: [^ false].
object at: field put: val.
self changed: #text.
^ true!
fieldList
"Answer a collection of the keys of the inspected dictionary."
| keys |
keys _ object keys.
keys detect: [:key | (key class == Symbol) not]
ifNone: [^keys asSortedCollection]. "sort dictionaries with Symbol keys"
^keys asOrderedCollection!
fieldMenu
"ActorDictionaryInspector flushMenus"
field == nil ifTrue: [^ActionMenu
labels: 'add field' withCRs
selectors: #(addField)].
ActorDictListMenu == nil ifTrue: [
ActorDictListMenu _ ActionMenu
labels: 'inspect\add field\remove' withCRs
lines: #(1)
selectors: #(inspectField addField removeField)].
^ActorDictListMenu!
fieldValue
^object at: field!
printItems
"Answer whether the elements of the fieldList need to be converted to strings"
^true! !
!ActorDictionaryInspector methodsFor: 'menu commands'!
addField
| aString key |
aString _ FillInTheBlank request: 'Enter key (an Actor identifier)'.
aString isEmpty ifFalse: [
key _ aString asSymbol.
object add: (Association key: key value: nil).
field _ key.
self changed: #field]!
removeField
(self confirm: 'Confirm removal of ', field printString) ifTrue: [
object removeKey: field.
field _ nil.
object changed: #all.]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
ActorDictionaryInspector class
instanceVariableNames: ''!
!ActorDictionaryInspector class methodsFor: 'class initialization'!
flushMenus
"ActorDictionaryInspector flushMenus."
ActorDictListMenu _ nil! !
SMACKInspector subclass: #ActorCollectionInspector
instanceVariableNames: ''
classVariableNames: 'ActorCollectionMenu '
poolDictionaries: ''
category: 'Actors-Inspectors'!
ActorCollectionInspector comment:
'I am a special kind of SMACKInspector which knows how to inspect collections.'!
!ActorCollectionInspector methodsFor: 'menu commands'!
addField
field == nil
ifTrue: [object addLast: nil] "nothing selected"
ifFalse: [self fieldIndex isNil
ifTrue: [object addFirst: nil] "self selected"
ifFalse: [object add: nil beforeIndex: self fieldIndex]].
self changed: #field!
removeField
self fieldIndex isNil ifTrue: [^self].
object removeAtIndex: self fieldIndex.
self changed: #all! !
!ActorCollectionInspector methodsFor: 'field list'!
acceptText: aText from: aController
| val |
self fieldIndex isNil ifTrue: [^false].
val _ self evaluateText: aText string from: aController ifFail: [^false].
object at: self fieldIndex put: val.
self changed: #text.
^true!
fieldIndex
"Answer the index of the currently selected field, or nil if no index is selected."
field isNil ifTrue: [^nil].
field = 'self' ifTrue: [^nil].
^Integer readFromString: field!
fieldList
"Answer a collection of strings with 'self' and the indices of the
inspected ActorCollection."
^(Array with: 'self'),
((1 to: object size) collect: [:i | i printString])!
fieldMenu
"ActorCollectionInspector flushMenus"
self fieldIndex isNil ifTrue:
[^ActionMenu
labels: 'add'
selectors: #(addField)].
ActorCollectionMenu == nil ifTrue:
[ActorCollectionMenu _
ActionMenu
labels: 'inspect\insert\remove' withCRs
lines: #(1)
selectors: #(inspectField addField removeField)].
^ActorCollectionMenu!
fieldValue
field = 'self' ifTrue: [^object].
^object at: self fieldIndex! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
ActorCollectionInspector class
instanceVariableNames: ''!
!ActorCollectionInspector class methodsFor: 'class initialization'!
flushMenus
"Flush the menus."
"ActorCollectionInspector flushMenus."
ActorCollectionMenu _ nil! !
SMACKInspector subclass: #MailAddressInspector
instanceVariableNames: ''
classVariableNames: 'MailAddressMenu '
poolDictionaries: ''
category: 'Actors-Inspectors'!
MailAddressInspector comment:
'I am a special kind of inspector for Mail addresses, which knows how
to inspect the corresponding actor.'!
!MailAddressInspector methodsFor: 'field list'!
fieldMenu
"Answer with an action menu for the field view."
"MailAddressInspector flushMenus."
field == nil ifTrue: [^ActionMenu
labels: 'inspect actor'
selectors: #(inspectActor)].
MailAddressMenu == nil ifTrue:
[MailAddressMenu _ ActionMenu
labels: 'inspect\inspect actor' withCRs
selectors: #(inspectField inspectActor)].
^MailAddressMenu! !
!MailAddressInspector methodsFor: 'menu commands'!
inspectActor
"Inspect the actor referred to by the object."
object class == MailAddress ifTrue: [
(MailAddress mailer table at: object ifAbsent: [nil]) inspect]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
MailAddressInspector class
instanceVariableNames: ''!
!MailAddressInspector class methodsFor: 'class initialization'!
flushMenus
"Flush the menu."
"MailAddressInspector flushMenus."
MailAddressMenu _ nil!
!TextCollector subclass: #ActorTextCollector
instanceVariableNames: ''
classVariableNames: 'DefaultBehaviour TheTextCollector '
poolDictionaries: ''
category: 'Actors-Interface'!
ActorTextCollector comment:
'I support special instance creation methods for a `transcript'' for actors.'!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
ActorTextCollector class
instanceVariableNames: ''!
!ActorTextCollector class methodsFor: 'actor creation'!
newTranscript
"Create a global Actor called ActorTranscript, which behaves as
a transcript for actors."
"ActorTextCollector newTranscript."
self newTranscript: DefaultBehaviour!
newTranscript: behaviour
"Create a global Actor which behaves as a transcript, with
behaviour from the argument."
"ActorTextCollector newTranscript: ActorTextCollector defaultBehaviour."
Smalltalk at: #ActorTranscript put: (Actor withBehaviour: behaviour).!
open
"Create and schedule a view on my global instance."
"ActorTextCollector open."
TextCollectorView open: TheTextCollector label: 'Actor (', ActorTranscript printString, ') Transcript'! !
!ActorTextCollector class methodsFor: 'class initialization'!
initialize
"Initialize the class variables."
"ActorTextCollector initialize."
TheTextCollector _ self new.
DefaultBehaviour _ Behaviour block: [:slf :acq :com |
com name == #cr ifTrue: [TheTextCollector cr].
com name == #tab ifTrue: [TheTextCollector tab].
com name == #show ifTrue: [
TheTextCollector show: (com at: 1)].
com name == #clear ifTrue: [TheTextCollector clear].
com name == #flash ifTrue: [TheTextCollector flash; refresh]]! !
!ActorTextCollector class methodsFor: 'class access'!
defaultBehaviour
"Answer with the class variable representing the default behaviour
of instances of the receiver."
"ActorTextCollector defaultBehaviour."
^DefaultBehaviour! !
!ActorTextCollector class methodsFor: 'examples'!
example1
"ActorTextCollector example1."
ActorTranscript sendMessage: #cr.
ActorTranscript sendMessage: #show with: 'Hello world!!'.!
example2
"ActorTextCollector example2."
ActorTranscript sendMessage: #clear.
ActorTranscript sendMessage: #show with: 'Hello again!!'.
ActorTranscript sendMessage: #flash.!
example3
"ActorTextCollector example3."
ActorTranscript sendMessage: #clear.
ActorTranscript sendMessage: #show with: 'First Message, '.
ActorTranscript sendMessage: #show with: 'Second Message '.
ActorTranscript sendMessage: #show with: 'and Third Message'.! !
ActorTextCollector initialize!
Object subclass: #RecursiveFactorial
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Smalltalk examples'!
RecursiveFactorial comment:
'I represent a factorial calculator, using a recursive algorithm.'!
!RecursiveFactorial methodsFor: 'factorial'!
factorial: n
"Perform a recursive factorial computation."
n <= 1
ifTrue: [^n]
ifFalse: [^n * (self factorial: (n - 1))]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
RecursiveFactorial class
instanceVariableNames: ''!
!RecursiveFactorial class methodsFor: 'examples'!
example1
"RecursiveFactorial example1."
Transcript cr; show: (RecursiveFactorial new factorial: 20) printString!
example2
"RecursiveFactorial example2."
| fac |
fac _ RecursiveFactorial new.
Transcript cr; show: (Time millisecondsToRun: [
1000 timesRepeat: [fac factorial: 20]]) printString! !
Object subclass: #DivideAndConquerFactorial
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Smalltalk examples'!
DivideAndConquerFactorial comment:
'I represent a factorial computation, using a doubly recursive
`divide-and-conquer'' algorithm.'!
!DivideAndConquerFactorial methodsFor: 'factorial'!
factorial: n
"Answer with n factorial, using a recursive divide-and-conquer algorithm."
^self rangeProductLow: 1 high: n!
rangeProductLow: lo high: hi
"Answer with the product of the numbers between lo and hi."
| mid |
(lo = hi) ifTrue: [^lo].
(lo > hi) ifTrue: [^1].
(lo < hi) ifTrue: [
mid _ (lo + hi ) // 2.
^(self rangeProductLow: lo high: mid) * (self rangeProductLow: mid + 1 high: hi)]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
DivideAndConquerFactorial class
instanceVariableNames: ''!
!DivideAndConquerFactorial class methodsFor: 'examples'!
example1
"DivideAndConquerFactorial example1."
Transcript cr; show: (DivideAndConquerFactorial new factorial: 20) printString!
example2
"DivideAndConquerFactorial example2."
| fac |
fac _ DivideAndConquerFactorial new.
Transcript cr; show: (Time millisecondsToRun: [
1000 timesRepeat: [fac factorial: 20]]) printString! !
Object subclass: #IterativeFactorial
instanceVariableNames: 'current '
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Smalltalk examples'!
IterativeFactorial comment:
'I represent a factorial calculator, using an interative algorithm.'!
!IterativeFactorial methodsFor: 'factorial'!
factorial: n
"Perform an iterative factorial computation."
current _ 1.
^self iterate: n!
iterate: n
"Perform an iterative factorial step."
(n <= 1)
ifTrue: [^current]
ifFalse: [
current _ current * n.
^self iterate: (n - 1)]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
IterativeFactorial class
instanceVariableNames: ''!
!IterativeFactorial class methodsFor: 'examples'!
example1
"IterativeFactorial example1."
Transcript cr; show: (IterativeFactorial new factorial: 20) printString.!
example2
"IterativeFactorial example2."
| fac |
fac _ IterativeFactorial new.
Transcript cr; show: (fac factorial: 3) printString.
Transcript cr; show: (fac factorial: 10) printString!
example3
"IterativeFactorial example3."
| fac |
fac _ IterativeFactorial new.
Transcript cr; show: (Time millisecondsToRun: [
1000 timesRepeat: [fac factorial: 20]]) printString! !
Object subclass: #Surrogate
instanceVariableNames: 'proxy '
classVariableNames: ''
poolDictionaries: ''
category: 'Actors-Smalltalk examples'!
Surrogate comment:
'I represent a simple implementation of surrogates.'!
!Surrogate methodsFor: 'synchronising'!
doesNotUnderstand: aMessage
"Any message to a Surrogate will end up here."
^proxy perform: aMessage selector withArguments: aMessage arguments! !
!Surrogate methodsFor: 'private'!
setProxy: anObject
"Set the proxy to be anObject."
proxy _ anObject! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
Surrogate class
instanceVariableNames: ''!
!Surrogate class methodsFor: 'instance creation'!
newOn: anObject
"Create a new instance of the receiver, being a surrogate for anObject."
^self new setProxy: anObject! !
!Surrogate class methodsFor: 'class initialization'!
initialize
"must avoid the checks"
superclass _ nil
"Surrogate initialize."! !
Surrogate initialize!